{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Dependencies.GUI.Actions
-- Copyright   :  (c) 2009--2010 TU Dortmund
-- License     :  BSD3
--
-- Maintainer  :  menge@udo.cs.uni-dortmund.de
-- Stability   :  experimental
-- Portability :  non-portable
--
-- contains all IO-Actions that can be executed from the GUI
--
-----------------------------------------------------------------------------

module Language.Dependencies.GUI.Actions where

-- local
import Language.Dependencies.GUI.Types 
import Language.Dependencies.Language
import Language.Dependencies.References

-- base
import Prelude hiding (writeFile)
import Data.IORef
import Data.Maybe(fromJust,isJust,isNothing)
import Data.List (find,findIndex,sort)
import Control.Monad ((=<<),when)
import Data.Char (toLower)

-- io
import System.IO (withFile,IOMode(..),hPutStr,hClose)

-- filepath
import System.FilePath 
  ((</>),takeExtension,takeFileName,makeRelative)
import System.Directory 
 (doesDirectoryExist,getCurrentDirectory,getDirectoryContents,
 makeRelativeToCurrentDirectory)

-- bytestring
import qualified Data.ByteString.Char8 as BS (hGetContents,unpack)

-- containers
import Data.Tree ( Tree(Node,rootLabel) )

-- gtk
import Graphics.UI.Gtk hiding (Language,get) 

-- gtksourceview
import Graphics.UI.Gtk.SourceView 

-- commands
import System.Cmd (rawSystem)

-- generated on-the-fly by cabal
import Paths_depedit (getDataFileName,getDataDir) 

-- |suffix of window title
suffix :: String
suffix = " - depedit"

-- |unsaved document
unsavedDoc :: String
unsavedDoc = "Unsaved document"

-- | a list of pairs of gtk-ids and GUIActions 
menuActions :: [(String,AstAction ())]
menuActions = 
  [("mNew",actionEmptyGUI)
  ,("mParseAll",actionReparseAll)
  ,("mOpenConfig",actionOpenConfig)
  ,("mSaveConfig", actionSaveConfig)
  ,("mAddRelationSrcView",actionAddRelationSrc)
  ,("mModifyRelation",actionModifyRelation)
  ,("mDeleteRelation",actionDeleteRelation)
  ,("mCheckRelation",actionCheckRelation)  
  ,("mSaveAsConfig",actionSaveAsConfig)
  ,("mOpenLeft",actionDlgOpenRun L)
  ,("mParseLeft",actionReparse L)
  ,("mParseRight",actionReparse R)
  ,("mOpenRight",actionDlgOpenRun R)
  ,("mParseAll",actionReparseAll)
  ,("mSaveLeft",actionSave L)
  ,("mSaveRight",actionSave R)
  ,("mSaveAsLeft",actionDlgSaveRun L)
  ,("mSaveAsRight",actionDlgSaveRun R)  
  ,("mPathLeft",actionJumpToPathInteractive L)
  ,("mPathRight",actionJumpToPathInteractive R)
  ,("mSetPathLeft",actionSetPath L)
  ,("mSetPathRight",actionSetPath R)
  ,("mCut",actionCutSource)
--  ,("mCopy",actionCopySource)
  --,("mPaste",actionPasteSource)
  ,("mDelete",actionDeleteSource)
  ,("mPathTreeRight",actionSetPathByTreeview L)
  ,("mPathTreeRight",actionSetPathByTreeview R)
  ,("mAbout",actionAbout)
  ,("mShowHelp",actionHelp)
  ,("mQuit",actionQuit)
  ]



-- -------------------------------------------------------------------
-- * filemenu menu actions
-- -------------------------------------------------------------------

-- | resets the GUI, 
actionEmptyGUI :: AstAction ()
actionEmptyGUI ref = do
  g <- getGui ref
  mapM_ clearTreeView =<< getTreeViews ref
  mapM_ (\s -> textBufferSetText s []) =<< getSourceBuffers ref
  windowSetTitle (window g) (unsavedDoc++suffix)  


-- |filechooser dialog to open a configuartion file
actionOpenConfig :: AstAction ()
actionOpenConfig ref = do
  changedConfig <- getConfigChanged ref
  when changedConfig $ actionQuitWorkerCo ref >> return ()
  gui <- getGui ref 
  dia <- fileChooserDialogNew 
    (Just "depedit") 
    Nothing 
    FileChooserActionOpen 
    []
  dialogAddButton dia stockCancel ResponseCancel
  dialogAddButton dia stockOpen ResponseOk

  widgetShowAll dia
  response <- dialogRun dia
  case response of 
    ResponseCancel -> return ()
    ResponseOk     -> 
      whenJustM
        (fileChooserGetFilename dia) $ 
        \file -> do
          contents <- readFile file
          setConfig (readConfig contents) ref
          setConfigFile file ref
    _ -> return ()
  widgetHide dia

-- |reparse both sourceviews
actionReparseAll :: AstAction ()
actionReparseAll ref = actionReparse L ref >> actionReparse R ref

-- | updates the sourceview of an area with a given file
-- , chooses a language by extension and parses the file
actionLoadHeadless :: Area -> FilePath -> AstAction ()
actionLoadHeadless area file ref = do
  sb <- getSourceBuffer area ref 
  tv <- getTreeView area ref
  setcFile area file ref
  s <- getAstState ref

  let langs = languages $ state s
  windowSetTitle 
    (window $ gui s) 
    (takeFileName file ++ suffix)
  lbl <- getLabel area ref
  labelSetLabel lbl =<< makeRelativeToCurrentDirectory file  
  catch 
    (do
      contents <- withFile 
        file ReadMode (fmap BS.unpack . BS.hGetContents)
      textBufferSetText sb contents
      deleteStar area ref
    )
    print
  whenJustM
    (getLanguage area ref) $
    \l -> actionParse area l ref >> return ()
      
-- |saves current file if a file is active or calls "save as"-dialog
actionSaveWorker :: Area -> String -> FilePath -> AstAction ()
actionSaveWorker a plain file ref = 
  case file of
    "Unsaved document"  -> actionDlgSaveRun a ref
    otherwise           -> do 
      deleteStar a ref 
      writeFile file plain 

-- |saves a configuration file
actionSaveConfig :: AstAction ()
actionSaveConfig ref = do
  setConfigChanged False ref
  writeFile "Rulefile" . concatMap (\r-> show r ++ "\n")
    =<< listStoreToList =<< getStoreRelation ref


-- |launches a dialog to save a configuration
actionSaveAsConfig :: AstAction ()
actionSaveAsConfig ref = do
  dia <- fileChooserDialogNew 
    (Just "depedit") 
    Nothing 
    FileChooserActionSave 
    []
  dialogAddButton dia stockCancel ResponseCancel
  dialogAddButton dia stockOpen ResponseOk

  widgetShowAll dia
  response <- dialogRun dia
  case response of 
    ResponseCancel -> return ()
    ResponseOk     -> do
       maybeFile <- fileChooserGetFilename dia
       case maybeFile of
         Nothing-> return () 
         Just file -> do
            setConfigChanged False ref
            writeFile file . concatMap (\r-> show r ++ "\n")
              =<< listStoreToList =<<  getStoreRelation ref
    _ -> return ()
  widgetHide dia

-- |launches quit-dialog, return value indicates if depedit
-- should be closed
actionQuitWorker :: Area -> AstAction Bool
actionQuitWorker a ref = do
      dia <- dialogNew
      dialogAddButton dia stockYes ResponseYes
      dialogAddButton dia stockNo ResponseNo
      dialogAddButton dia stockCancel ResponseCancel
      contain <- dialogGetUpper dia
  
      windowSetTitle dia "depedit"
      containerSetBorderWidth dia 2
      file <- getFile a ref
      lbl <- labelNew 
        (Just $ "Save changes to document \""++
                takeFileName file ++
                "\"?")
      boxPackStartDefaults contain lbl

      widgetShowAll dia
      response <- dialogRun dia
      gui <- getGui ref
      case response of 
        ResponseYes     -> do
          widgetHide dia 
          actionSave a ref 
          return True
        ResponseNo      -> widgetHide dia >> return True
        ResponseCancel  -> widgetHide dia >> return False
      
-- |launches quit-dialog, return value indicates if depedit
-- should be closed
actionQuitWorkerCo :: AstAction Bool
actionQuitWorkerCo ref = do
      dia <- dialogNew
      dialogAddButton dia stockYes ResponseYes
      dialogAddButton dia stockNo ResponseNo
      dialogAddButton dia stockCancel ResponseCancel
      contain <- dialogGetUpper dia
  
      windowSetTitle dia "depedit"
      containerSetBorderWidth dia 2
      lbl <- labelNew 
        (Just $ "Save changes to rulefile?")
      boxPackStartDefaults contain lbl

      widgetShowAll dia
      response <- dialogRun dia
      gui <- getGui ref
      case response of 
        ResponseYes     -> do
          widgetHide dia 
          actionSaveConfig ref
          return True
        ResponseNo      -> widgetHide dia >> return True
        ResponseCancel  -> widgetHide dia >> return False
        
-- | destroys window widget 
actionQuit :: AstAction ()
actionQuit ref = do 
  changedL <- getChanged L ref 
  changedR <- getChanged R ref 
  changedC <- getConfigChanged ref
  gui <- getGui ref
  b1 <- if changedL then actionQuitWorker L ref else return True
  b2 <- if changedR then actionQuitWorker R ref else return True
  c  <- if changedC then actionQuitWorkerCo ref else return True  
  when (b1 && b2 && c) $ widgetDestroy (window gui)

    
-- * area specific menu actions

-- |saves a file 
actionSave :: Area -> AstAction ()
actionSave a ref = do
  url <- getFile a ref
  sb <- getSourceBuffer a ref
  text <- getText sb 
  actionSaveWorker a text url ref

-- |save current cursor position
actionSetPath :: Area -> AstAction ()
actionSetPath a ref = do
  maybeLoc <- getCursorPosition a ref
  case maybeLoc of
    Just loc -> do
            maybeDPath <- actionGetPath a loc ref
            case maybeDPath of
               Nothing -> return ()
               Just dpath -> do
                 setPath a (toGtkPath dpath) ref
    _ -> popDia ("Couldn't set path in "++ show a++" source view.") 
                MessageError ref  
 
 
-- |adds a relation by recently selected positions in srcview
actionAddRelationSrc :: AstAction ()
actionAddRelationSrc ref = do
  maybeRel <- buildRelation ref
  case maybeRel of
    Just r -> do
      appendRelation r ref
      setConfigChanged True ref
    _      -> return ()   

-- |builds a relation by recently selected positions in
-- sourceviews
buildRelation :: AstAction (Maybe Relation)
buildRelation ref = do
  p1 <- fmap toDPath $ getPath L ref
  p2 <- fmap toDPath $ getPath R ref
  dir <- getCurrentDirectory
  fl <- fmap (makeRelative dir) $ getFile L ref
  fr <- fmap (makeRelative dir) $ getFile R ref
  return $ Just $ Relation (Elem p1 fl) (Elem p2 fr) (CompareId [])

actionModifyRelation :: AstAction ()
actionModifyRelation ref = do
  tv <- getTvRelation ref
  sel <- treeViewGetSelection tv
  numberrows <- treeSelectionCountSelectedRows sel
  if numberrows == 0
    then popDia "Select a relation in order to modify it" MessageWarning ref
    else do
      i <- fmap (head.head) $ treeSelectionGetSelectedRows sel
      maybeRel <- buildRelation ref
      case maybeRel of
        Just r -> do
          modifyRelation i r ref
          setConfigChanged True ref
        _      -> return ()   

-- |deletes seleted relation. Shows an error dialog if no relation is selected
actionDeleteRelation :: AstAction ()
actionDeleteRelation ref = do
  maybeIndex <- getSelectedIndex ref
  case maybeIndex of
    Nothing -> popDia "Select a relation in order to delete it" MessageWarning ref
    Just i  -> do
      setConfigChanged True ref
      (flip listStoreRemove) i =<< getStoreRelation ref

-- |checks a selected relation
actionCheckRelation :: AstAction ()
actionCheckRelation ref = do
  maybeIndex <- getSelectedIndex ref
  ck <- fmap (check . options) (getAstState ref)
  case maybeIndex of
    Nothing -> popDia "Select a relation in order to check it" MessageWarning ref
    Just i  -> do
      rel@(Relation (Elem p1 fp1) (Elem p2 fp2) f)
        <- (flip listStoreGetValue) i =<< getStoreRelation ref
      b <- ck rel
      popDia (show b) MessageInfo ref
 
-- |jumps to the node in tree given by recent cursor position,
-- returning the depedit-path to this node
actionGetPath :: Area -> Loc -> AstAction (Maybe DPath)
actionGetPath a srcloc ref = do  
  tv <- getTreeView a ref
  -- reparse and set cursor in treeview
  maybeLang <- getLanguage a ref
  case maybeLang of
    Nothing -> do
      file <- getFile a ref
      popDia 
        ("Couldn't find a parser for extension "++ takeExtension file) 
        MessageError 
        ref 
      return Nothing   
    Just lang -> do 
      t <- actionParse a lang ref 
      let sl = filter 
                 (\(s,_) -> srcloc `isSubSrcLocOf` s) 
                 (sourceLocations lang t) 
      case sort sl of
        [] -> do
          popDia
            ("Couldn't find a source location in tree for "++
             "cursor position "++ show srcloc ++" in "++show a++" tree")
            MessageError
            ref
          return Nothing   
        xs -> do
          case minimum sl of
            (_,GtkPath []) -> do
              popDia
                ("Couldn't find a parent node in tree for "++
                 "cursor position "++ show srcloc ++" in "++show a++" source view")
                MessageError
                ref    
              return Nothing  
            (s,gtkPath) -> do
              actionJumpToGivenPath tv $ gtkPath
              return (Just $ toDPath $ gtkPath)
 
-- |returns true iff first srcloc is smaller than second one
isSubSrcLocOf :: Loc -> Loc -> Bool
isSubSrcLocOf = (<=)

-- |jump to path in given treeview 
actionJumpToGivenPath :: TreeView -> GtkPath -> IO ()
actionJumpToGivenPath tv (GtkPath p) = do
  treeViewExpandToPath tv p
  treeViewSetCursor tv p Nothing 


-- |sets the path of a selected item in a treeview as current path
actionSetPathByTreeview :: Area -> AstAction ()
actionSetPathByTreeview a ref = do
  tv <- getTreeView a ref
  sel <- treeViewGetSelection tv
  rows <- treeSelectionGetSelectedRows sel
  case rows of
    []    -> return ()
    (p:_) -> setPath a (GtkPath p) ref
  
  
-- |type a tree path. 'actionJumpToPathInteractive' jumps
-- to given path and sets it as current path
actionJumpToPathInteractive :: Area -> AstAction ()
actionJumpToPathInteractive a ref = do
  dia <- dialogNew
  dialogAddButton dia stockCancel ResponseCancel
  dialogAddButton dia stockOpen ResponseOk
  
  vbox <- dialogGetUpper dia
  textField <- textViewNew 
  label <- labelNew $ Just "Type a tree path, e.g. [1,4,1]"
  boxPackStart vbox textField PackNatural 10
  
  widgetShowAll dia
  response <- dialogRun dia
  case response of 
    ResponseOk     -> do
      buffer <- textViewGetBuffer textField
      startIter <- textBufferGetStartIter buffer
      endIter <- textBufferGetEndIter buffer
      str <- textBufferGetText buffer startIter endIter False
      case parseIntList str of
        []  -> popDia "Couldn't parse your input" MessageError ref 
        p   -> do
          tv <- getTreeView a ref
          setPath a (GtkPath p) ref
          actionJumpToGivenPath tv $ GtkPath p
        
    _ -> return ()
  widgetHide dia
  
  return ()

-- | launches open dialog
actionDlgOpenRun :: Area -> AstAction ()
actionDlgOpenRun a ref = do
  changed <- getChanged a ref
  when changed $ actionQuitWorker a ref >> return ()
  gui <- getGui ref 
  dia <- fileChooserDialogNew 
    (Just "depedit") 
    Nothing 
    FileChooserActionOpen 
    []
  
  setupFilter dia ref
  
  dialogAddButton dia stockCancel ResponseCancel
  dialogAddButton dia stockOpen ResponseOk

  widgetShowAll dia
  response <- dialogRun dia
  case response of 
    ResponseCancel -> return ()
    ResponseOk     -> 
      whenJustM
        (fileChooserGetFilename dia) $ 
        \file -> actionLoadHeadless a file ref
    _ -> return ()
  widgetHide dia

-- |adds a file filter to given file chooser
setupFilter :: FileChooserDialog -> AstAction ()
setupFilter fc ref = do
  myFilter <- fileFilterNew
  fileFilterAddCustom myFilter [] f
  fileChooserSetFilter fc myFilter 
  where
    -- f returns true iff s has an extension which can be 
    -- associated with a language
    f _ _ (Just s) _ = return . 
      any ((takeExtension s)==) . concatMap exts =<< getLangs ref
    f _ _ _ _ = return False
    

-- | launches save dialog
actionDlgSaveRun :: Area -> AstAction ()
actionDlgSaveRun a ref = do
  dia <- fileChooserDialogNew 
    (Just "depedit") 
    Nothing 
    FileChooserActionSave 
    []
  dialogAddButton dia stockCancel ResponseCancel
  dialogAddButton dia stockSave ResponseOk

  widgetShowAll dia
  response <- dialogRun dia
  case response of 
    ResponseCancel -> return ()
    ResponseOk     -> do
       maybeFile <- fileChooserGetFilename dia
       case maybeFile of
         Nothing-> return () 
         Just file -> do
            deleteStar a ref
            sb <- getSourceBuffer a ref
            writeFile file =<< getText sb 
            lbl <- getLabel a ref
            fileRel <- makeRelativeToCurrentDirectory file
            labelSetText lbl fileRel
            setcFile a fileRel ref
    _ -> return ()
  widgetHide dia

-- |parses content of given area
actionReparse :: Area -> AstAction ()
actionReparse a ref = do
  whenJustM (getLanguage a ref) $
    \l -> actionParse a l ref >> return () 
 


-- -------------------------------------------------------------------
-- ** editmenu menu actions
-- -------------------------------------------------------------------

-- |moves selected source to clipboard (cut)
actionCutSource :: AstAction ()  
actionCutSource ref = do
  actionCopySource ref
  actionDeleteSource ref

actionCopySource :: AstAction ()
actionCopySource ref = do
  mapM_ (\sb -> actionCopySourceBuffer sb ref) =<< getSourceBuffers ref

-- |copies selected source to clipboard  
actionCopySourceBuffer :: SourceBuffer -> AstAction () 
actionCopySourceBuffer sb ref = do
  gui <- getGui ref
  (start,end) <- textBufferGetSelectionBounds sb 
  clipBoard <- clipboardGet selectionClipboard
  clipboardSetText 
    clipBoard 
    =<< textBufferGetText sb start end True

-- |pastes text from clipboard at current cursor position  
actionPasteSource :: SourceBuffer -> AstAction ()
actionPasteSource sb ref = do 
  gui <- getGui ref
  clipBoard <- clipboardGet selectionClipboard
  clipboardRequestText clipBoard (insertAt sb) where
    insertAt :: SourceBuffer -> Maybe String -> IO ()
    insertAt tb m = whenJust m (textBufferInsertAtCursor tb)

-- |deletes selected source
actionDeleteSource :: AstAction ()
actionDeleteSource ref = do 
  mapM_ (\sb -> textBufferDeleteSelection sb False False) 
    =<< getSourceBuffers ref
  return ()

-- -------------------------------------------------------------------
-- * helpmenu menu actions
-- -------------------------------------------------------------------

-- |opens help in firefox
actionHelp :: AstAction ()
actionHelp _ = do
  helpfile <- getDataFileName ("data" </> "depedit.html")
  dir <- getDataDir
  rawSystem "firefox" [dir </> helpfile]
  return ()
    
-- | launches info dialog
actionAbout :: AstAction ()
actionAbout ref = do
  gui <- getGui ref
  aboutDialogSetUrlHook (\_ -> return ())
  licensefile <- getDataFileName ("data" </> "LICENSE.unwrapped")
  contents <- catch 
    (withFile licensefile ReadMode (fmap BS.unpack . BS.hGetContents))
    (\ioe -> return $ "Err" ++ show ioe)
  aboutDialogSetWrapLicense (dlgAbout gui) True 
  aboutDialogSetLicense (dlgAbout gui) (Just contents)
  widgetShow (dlgAbout gui)

-- -------------------------------------------------------------------
-- * other actions 
-- -------------------------------------------------------------------

-- |pops up an message dialog with a given message and type 
popDia :: String -> MessageType -> AstAction ()
popDia message t ref = do
  w <- getWindow ref
  dia <- messageDialogNew (Just w) [] t ButtonsOk message
  widgetShowAll dia
  response <- dialogRun dia
  widgetHide dia

-- | adds '*' to window title if file changed and sets state
actionBufferChanged :: Area -> AstAction ()
actionBufferChanged area ref = do
  gui <- getGui ref
  setChanged area True ref
  t <- windowGetTitle (window gui)
  when (head t /= '*') (windowSetTitle (window gui) ('*':t))


-- | parses the contents of the sourceview with the given language
-- returning the tree
actionParse :: Area -> Language -> AstAction (Tree String)
actionParse a l@(Language _ _ _ p to _ ad' _ _) ref = do
  g <- getGui ref
  sb <- getSourceBuffer a ref
  tv <- getTreeView a ref
  sourceBufferSetHighlightSyntax sb True
  setupSyntaxHighlighting sb l g
  plain <- getText sb 
  clearTreeView tv
  let ad = case ad' of 
        Just f -> f 
        Nothing-> id
--      eitherTree = fmap (to . everywhere (mkT ad)) (p plain)
      eitherTree = fmap to (p plain)

  -- error handling
  case eitherTree of
    Left (ErrLocation loc m) -> jumpToLoc loc sb
    _                        -> return ()
  -- build Tree String
  let t = case eitherTree of
          Right ast                 -> ast
          Left Err                  -> Node "Parse error" []
          Left (ErrMessage m)       -> Node m []
          Left (ErrLocation srcloc m) -> 
            Node ("Parse error at:"++show srcloc) [] 
  
  model <- treeStoreNew [t]
  treeViewSetModel tv model
  col <- treeViewColumnNew
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True 
  cellLayoutSetAttributes 
    col 
    renderer 
    model 
    (\row -> [ cellText := row ] )
  treeViewAppendColumn tv col 
  return t

setupSyntaxHighlighting :: SourceBuffer -> Language -> GUI -> IO ()
setupSyntaxHighlighting sb l g = do
      langManager <- sourceLanguageManagerGetDefault
      maybeLang <- sourceLanguageManagerGetLanguage 
        langManager 
        (map toLower $ syntax l)
      sourceBufferSetHighlightSyntax sb True
      sourceBufferSetLanguage sb maybeLang

-- -------------------------------------------------------------------
-- * Helpers
-- -------------------------------------------------------------------

-- |similar to @when@ 
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust m action =
  when (isJust m) ((action.fromJust) m) 
  
-- |similar to @whenJust@, but value is inside a monad
whenJustM :: Monad m => m(Maybe a) -> (a -> m ()) -> m ()
whenJustM val action = do
  m <- val
  when (isJust m) ((action.fromJust) m)  

-- | helper for various text-processing actions
getText :: TextBufferClass c => c -> IO String
getText sb = do
  start <- textBufferGetStartIter sb
  end <- textBufferGetEndIter sb
  textBufferGetText sb start end True
  
-- |safe function to write files
writeFile :: FilePath -> String -> IO ()
writeFile f str = catch
  (withFile f WriteMode (\h -> hPutStr h str >> hClose h))
  print

clearTreeView :: TreeView -> IO ()
clearTreeView t = do
  c <- treeViewGetColumn t 0
  case c of 
    Just col-> treeViewRemoveColumn t col >> return ()
    Nothing -> return ()
  

 
  
-- |tries to find a language based on the extension of 
-- current file name
getLanguage :: Area -> AstAction (Maybe Language)
getLanguage area ref = do
  file <- getFile area ref
  langs <- getLangs ref
  return $ find (elem (takeExtension file) . exts) langs

-- |removes @*@ from file name if existing and updates state
deleteStar :: Area -> AstAction ()
deleteStar a ref = do
  lbl <- getLabel a ref
  text <- labelGetText lbl
  setChanged a False ref
  case reverse text of
    ('*':_)  -> labelSetText lbl $ init text
    _        -> return () 

-- |appends a star to filename 
addStar :: Area -> AstAction ()
addStar a ref = do
  setChanged a True ref
  lbl <- getLabel a ref
  text <- labelGetText lbl
  case reverse text of
    []       -> return ()
    ('*':_)  -> return ()
    x        -> labelSetText lbl $ text++['*']

-- |returns the current cursor position in a source view.
getCursorPosition :: Area -> AstAction (Maybe Loc)
getCursorPosition a ref = do
  (start,end) <- textBufferGetSelectionBounds 
    =<< getSourceBuffer a ref
  maybeLang <- getLanguage a ref
  case maybeLang of
    Nothing -> return Nothing
    Just l ->
      case srcLoctype l of
        Coordinate _ _ -> do
          line1 <- textIterGetLine start
          row1 <- textIterGetLineOffset start
          line2 <- textIterGetLine end
          row2 <- textIterGetLineOffset end
      -- we add 1 to all values to synchronise cursor positions
      -- and line numbers of a textview
          return $ Just $ Coordinate (line1+1,row1+1) (line2+1,row2+1)
        OffSet _ _ -> do
          o1 <- textIterGetOffset start
          o2 <- textIterGetOffset end
          return $ Just $ OffSet o1 o2

-- |returns all source locations and paths to source
-- locations in current tree
sourceLocations :: Language -> Tree String -> [(Loc,GtkPath)]
sourceLocations l = getSourceLocations l . toGtk . calcPaths [0]
  where
  toGtk :: Tree (a,[Int]) -> Tree (a,GtkPath)
  toGtk (Node (a,p) cs) = Node (a,GtkPath p) $ map toGtk cs
  
  calcPaths :: [Int] -> Tree String -> Tree (String,[Int])
  calcPaths p (Node l cs) = 
    let paths = zipWith (\p e->p++[e]) (repeat p) [0,1..] in
    Node (l,p) (zipWith (\subtree p -> calcPaths p subtree) cs paths)

  getSourceLocations :: Language 
                     -> Tree (String,GtkPath) 
                     -> [(Loc,GtkPath)]
  getSourceLocations l t@(Node (_,GtkPath p) cs) =
    let xs = srcLoc l $ fmap fst t in
      case xs of
        []    -> concatMap (getSourceLocations l) cs
        (x:_) -> [(x,GtkPath $ init p)]

-- |jumps to location in sourcebuffer
jumpToLoc :: Loc -> SourceBuffer -> IO ()
jumpToLoc l sb = do
  iter <- textBufferGetStartIter sb
  f l iter
  textBufferPlaceCursor sb iter
  where 
    f :: Loc -> TextIter -> IO ()
    f l iter = do
      case l of
        (OffSet o1 _) -> textIterSetOffset iter o1
        (Coordinate (x1,y1) _) -> do
          textIterSetLine iter x1
          textIterSetLineOffset iter y1  

-- |sets given configuration in liststore
setConfig :: Configuration -> AstAction ()
setConfig config ref = do
      store <- getStoreRelation ref
      listStoreClear store
      mapM_ (\x -> listStoreAppend store x) $ relations config

-- |adds current relation to liststore          
appendRelation :: Relation -> AstAction ()
appendRelation rel ref = do
  (flip listStoreAppend) rel =<< getStoreRelation ref
  return ()

modifyRelation :: Int -> Relation -> AstAction ()
modifyRelation i rel ref = do
  store <- getStoreRelation ref
  listStoreSetValue store i rel
          
updateTreeView :: [Tree String] -> TreeView -> IO ()
updateTreeView ts tv = do        
  clearTreeView tv
  model <- treeStoreNew ts
  treeViewSetModel tv model
  col <- treeViewColumnNew
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True 
  cellLayoutSetAttributes 
    col 
    renderer 
    model 
    (\row -> [ cellText := row ] )
  treeViewAppendColumn tv col  
  treeViewExpandAll tv     

-- |returns the index of seleted relation
getSelectedIndex :: AstAction (Maybe Int)
getSelectedIndex ref = do
  sel <- treeViewGetSelection =<< getTvRelation ref
  numberrows <- treeSelectionCountSelectedRows sel
  if (numberrows > 0) 
    then do
      i <- fmap (head.head) $ treeSelectionGetSelectedRows sel
      return $ Just i
    else return Nothing  
